Unit uMainwindow;
{.$DEFINE FreeBuild}
{$DEFINE SlowUpdate}

{.$DEFINE Win9xTest}

{$DEFINE TraceProgress}

{.$DEFINE DragDrop}
{$DEFINE Sizeable}
{$DEFINE TextColors}

{.$DEFINE HookDLL}

{$DEFINE DelayMessages}

{.$DEFINE LoadManual}

{.$DEFINE IE4Scrollbars}

{$DEFINE AppBar}

interface

uses
  Windows,
  Messages,
  SysUtils,
  Classes,
  Graphics,
  Forms,
  Controls,
  ShellAPI,

  Registry,

  (* System units *)
  uConstants,
  uServices,
  uConfig,
  uThreads,
  uActiveDesktop,
  uFakeLoad,
  uCommandline,
  {$IFDEF IE4Scrollbars}
  uFlatSB,
  {$ENDIF}

  {$IFDEF HookDLL}
  HookDef,
  {$ENDIF}

  uCursors,
  frmServiceSelector,

  ExtDlgs,

  (* Graphics extensions *)
  {$IFDEF LoadManual}
  JPEG,
  {$ELSE}
  NViewLib,
  {$ENDIF}

  Dialogs,
  Menus,
  ClipBrd,
  ExtCtrls
  ;

Const VersionMessage = 'eConsole v1.0j' +
                       ' (c) 1998,2000 Max Maischein'
      ;

Type TBackgroundPosition = ( bkgndTile, bkgndRelative );
     (* The different kinds of backgrounds we'll allow *)

Type TBackgroundDrawProc = Procedure( aForm : TForm; aClientArea : TRect; aBitmapOffset : TPoint; aCanvas : TCanvas; aBackground : TBitmap );
     (* A procedure that draws the background of a form *)

Type TMessagesForwarder = Procedure( Messages : TList ) of Object;

Const transTinted = -1;

(* The different kinds of positions the window can appear at : *)
const positionConsole = 0;
      positionFixed = 1;

{$IFDEF AppBar}
Const ABE_NONE = -1;

      KEY_ID = 1;

      HideWaitTime = 200; (* In ms *)
{$ENDIF}

{$IFDEF TextColors}
(* Text coloring section *)
Type TColorAttr = Record
       FG, BG : TColor;
     End;
Var TextColors : Array[ Byte ] of TColorAttr;
{$ENDIF}

type
  TForm1 = class(TForm)
    RefreshTimer: TTimer;
    PopupMenu: TPopupMenu;
    mnuFont: TMenuItem;
    mnuShowconsole: TMenuItem;
    mnuTransparency0: TMenuItem;
    mnuTransparency25: TMenuItem;
    mnuTransparency50Hatchpattern: TMenuItem;
    mnuTransparency50Scanlines: TMenuItem;
    mnuTransparency75: TMenuItem;
    mnuTransparency100: TMenuItem;
    CursorTimer: TTimer;
    mnuSelectCursor: TMenuItem;
    mnuStretchBackground: TMenuItem;
    mnuBackgroundimage: TMenuItem;
    mnuNoborder: TMenuItem;
    N2: TMenuItem;
    mnuFastDrag: TMenuItem;
    mnuGluetodesktop: TMenuItem;
    ConsoleCheckTimer: TTimer;
    mnuRelativeBackground: TMenuItem;
    mnuAnimatecursor: TMenuItem;
    mnuDirectBlit: TMenuItem;
    mnuAutosize: TMenuItem;
    mnuClose: TMenuItem;
    mnuTransparency: TMenuItem;
    Window1: TMenuItem;
    mnuBackground: TMenuItem;
    mnuPaste: TMenuItem;
    mnuCloseDivider: TMenuItem;
    mnuPasteDivider: TMenuItem;
    mnuSelectTintcolor: TMenuItem;
    N3: TMenuItem;
    mnuTintimage: TMenuItem;
    mnuMousedraggable: TMenuItem;
    HideTimer: TTimer;
    mnuDockable: TMenuItem;
    mnuAutohide: TMenuItem;
    mnuDontMinimize: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure RefreshTimerTimer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure mnuShowconsoleClick(Sender: TObject);
    procedure mnuFontClick(Sender: TObject);
    procedure mnuTransparency0Click(Sender: TObject);
    procedure CursorTimerTimer(Sender: TObject);
    procedure mnuSelectCursorClick(Sender: TObject);
    procedure mnuStretchBackgroundClick(Sender: TObject);
    procedure mnuBackgroundimageClick(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure mnuNoborderClick(Sender: TObject);
    procedure mnuFastDragClick(Sender: TObject);
    procedure mnuGlueToDesktopClick(Sender: TObject);
    procedure ConsoleCheckTimerTimer(Sender: TObject);
    procedure mnuRelativeBackgroundClick(Sender: TObject);

    {$IFDEF Sizeable}
    procedure mnuAutosizeClick(Sender: TObject);
    {$ENDIF}

    procedure mnuAnimatecursorClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormDeactivate(Sender: TObject);
    procedure mnuDirectBlitClick(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure mnuCloseClick(Sender: TObject);
    procedure mnuPasteClick(Sender: TObject);
    procedure PopupMenuPopup(Sender: TObject);
    procedure mnuSelectTintcolorClick(Sender: TObject);
    procedure mnuMousedraggableClick(Sender: TObject);
    procedure HideTimerTimer(Sender: TObject);
    procedure mnuDockableClick(Sender: TObject);
    procedure mnuAutohideClick(Sender: TObject);
    procedure mnuDontMinimizeClick(Sender: TObject);

  private
    { Private-Deklarationen }

    (* While the form is initializing ... *)
    Initializing : Boolean;

    ShellWnd : THandle;
    Console : THandle;
    {ConsoleIn : THandle;}

    { The text of the lines of the console window }
    Lines : TStringList;    { now }
    OldLines : TStringList; { last time we checked }

    fBackground : TBitmap;
    BackgroundFilename : String; (* If the background transparency is 0 *)
    fBackgroundTiled : Boolean;  (* Is the background wallpaper tiled ? *)

    {$IFDEF TraceProgress}
    fTrace : Boolean;
    {$ENDIF}

    _Screen : TBitmap;

    fWithBorderstyle : TFormBorderstyle;

    fTransparency : Integer;
    fRefreshMirror : Integer; (* Mirror of the RefreshTimer interval *)
    fFastDrag : Boolean;      (* Don't repaint while dragging/resizing *)
    fNoborder : Boolean;      (* Does the window display a border and caption ? *)
    fMouseDraggable : Boolean;(* Can you move the window by clicking into it ? *)
    fAnimateCursor : Boolean; (* Animate the cursor even if the form does not have the input focus *)
    fDirectBlit : Boolean;    (* Should we blit directly to the screen or should we blit to an offscreen DC ? *)
    fOldDirectBlit : Boolean; (* Holds the value fDirectBlit while moving/sizing the form *)
    fDockable : Boolean;      (* Enables/disables the docking behaviour *)
    fAutohide : Boolean;      (* If the docked window does slide away when it loses focus *)
    fDontMinimize : Boolean;  (* If the console window can be minimized *)

    fStretchBackground : Boolean;
                              (* Should the background be stretched to fit the window ? *)

    fTintColor : TColor;      (* Should the image be tinted ? *)
    fHotkeyChar : Integer;    (* VK_xx keycode of the key to be pressed in conjunction with the
                                 windows key *)

    {$IFDEF Sizeable}
    (* Relative coordinates of the left upper corner of the visible section (updated when scrolling the window) *)
    FirstVisible : TPoint;

    fAutoSize : Boolean;      (* Does the console always size itself to the console size *)
    fConsoleSize : TPoint;    (* The size of the space needed for the console in pixels *)
    {$ENDIF}

    (* Do we use a relative or absolute background ? *)
    fBackgroundPainterType : TBackgroundPosition;
    fBackgroundPainter : TBackgroundDrawProc;

    Cursor : CCursor;
    CursorPos : TSmallPoint;
    CellSize : TRect;
    CursorName : String;
    fFormIsActive : Boolean;

    ConsoleSize : TSmallRect;

    ConfigFile : CConfiguration;
    fSaveConfig : Boolean;                   (* Is it OK to save the configuration ? *)

    ShellCommandLine : String;               (* The command line that is passed to the shell *)

    (* Support for moving the window when it has no title bar *)
    Dragging : Boolean;
    DragX, DragY : Integer; (* The coordinates where the mouse has the grip in the window *)

    (* Support for holding back repaint messages while moving the window *)
    Moving : Boolean;

    (* Support for effectively glueing the console to the desktop *)
    fGlueToDesktop : Boolean;

    (* The message forwarding mechanism *)
    fForwardMessages : TMessagesForwarder;

    {$IFDEF DelayMessages}
    (* Used to desynchronize the messages from the loop *)
    MessageTimer : TTimer;
    fMessageTimerInterval : Integer; (* Mirror for the config file *)
    DelayedMessages : TList;
    {$ENDIF}

    (* Win9x - Are we currently sending messages to the console ? *)
    fSending : Boolean;
    (* Win9x - Our last active caption bitmap *)
    OldCaption : TBitmap;

    (* Metrics section *)
    fXBorderWidth : Integer;
    fYBorderWidth : Integer;
    fCaptionHeight : Integer;

    (* Startup position *)
    fStartupPosition : Integer;               (* What is the kind of startup position we want ? *)
    fStartupX : Integer;                      (* Where should the window go ? *)
    fStartupY : Integer;

    {$IFDEF AppBar}
    AppBarData : TAppBarData;
    Hidden : Boolean;

    NormalSize : TPoint;
    BarSize : TPoint;
    {$ENDIF}

    Procedure SetBackground( aNewbackground : TBitmap );
    Property Background : TBitmap read fBackground write SetBackground;

    (* Procedure to load the currently used desktop background either from RAM or from disk *)
    Procedure LoadDesktopBackground;

    (* Function to load a user defined background image from disk - returns false if the user pressed
       cancel or another error occurred *)
    Function LoadBackgroundImage( const aFilename : String ) : Boolean;

    Procedure SetBGTransparency( aNewTransparency : Integer; aReloadBackground : Boolean );

    Procedure BuildText( aRowLength : LongInt; aRowCount : LongInt; aBuffer : Pointer );
    Procedure InvalidateLine( aLine : Integer );
    {Procedure InvalidateCell( aX, aY : Integer );}
    Procedure ReadInfo;

    Function GetCursorRect : TRect;
    Procedure ResizeConsole;
    Procedure ResizeScreenbuffer;

    Procedure WndProc( var rMessage : TMessage ); override;

    Procedure wmEnterSizeMove( var Message : TMessage ); message wm_EnterSizeMove;
    Procedure wmExitSizeMove( var Message : TMessage ); message wm_ExitSizeMove;

    Procedure wmWindowPosChanging( var Message : TMessage ); message wm_WindowPosChanging;

    Procedure wmEraseBackground( var Message : TMessage ); message wm_EraseBkgnd;
    (* We draw our background ourselves *)

    Procedure wmMove( var Message : TMessage ); message wm_Move;
{    Procedure wmShowWindow( var Message : TMessage ); message wm_ShowWindow;}

    (* Mouse support *)
    {Procedure wmMouseMove( var Message : TMessage ); message wm_MouseMove;}

    {$IFDEF DragDrop}
    Procedure wmDropFiles( Var Message : TMessage ); message wm_DropFiles;
    {$ENDIF}

    Procedure wmSettingChange( Var Message : TMessage ); message wm_SettingChange;

    {$IFDEF Sizeable}
    Procedure wmHScroll( var Message : TMessage ); message wm_HScroll;
    Procedure wmVScroll( var Message : TMessage ); message wm_VScroll;
    {Procedure wmSize( var Message : TWMSize ); message wm_Size;}
    {$ENDIF}

    { Property/configuration functions }

    Procedure SetFont( aFont : Pointer );
    Function GetFont : Pointer;

    Procedure SetTransparency( aTransparency : Pointer );
    Function GetTransparency : Pointer;

    Procedure SetRefresh( aValue : Pointer );
    Function GetRefresh: Pointer;

    {$IFDEF DelayMessages}
    Procedure SetMessagePump( aValue : Pointer );
    Function GetMessagePump : Pointer;
    {$ENDIF}

    Function GetRelativeBackground : Pointer;
    Procedure SetRelativeBackground( aValue : Pointer );

    Procedure SetTintColor( aColor : Pointer );
    Function GetTintColor : Pointer;

    Procedure SetBorder( aBorder : Boolean );
    Procedure SetFastDrag( aFastDrag : Boolean );
    Procedure SetGlueToDesktop( aValue : Boolean );
    Procedure SetAnimateCursor( aValue : Boolean );
    Procedure SetMouseDraggable( aValue : Boolean );
    Procedure SetStretchBackground( aValue : Boolean );
    Procedure SetDockable( aValue : Boolean );
    Procedure SetAutohide( aValue : Boolean );
    Procedure SetDontMinimize( aValue : Boolean );
    {$IFDEF Sizeable}
    Procedure SetAutosize( aValue : Boolean );
    {$ENDIF}

    Procedure SetDirectBlit( aValue : Boolean );

    (* This function is called after all configuration variables have been initialized
       with their saved values *)
    Procedure RefreshOptions;

    { The central message forwarding mechanism }
    (* Collects all keyboard messages currently in
       the queue and gobbles them into a list of messages to be passed to the console *)
    Procedure ForwardMessage( var Message : TMessage );

    (* Both forwarders take a TList of TMsg !! *)
    { Message forwarding for Win9x - yuck }
    Procedure ForwardMessageWin9x( aMessages : TList );
    {$IFDEF DelayMessages}
    Procedure W9xPumpMessages( aTimer : TObject );     (* Forwards all accumulated messages to the DOS box *)
    {$ENDIF}

    { Message forwarding for NT - clean and smooth }
    Procedure ForwardMessageNT( aMessages : TList );

    { Procedure to centralize setting of the caption - does not set the caption if it
      already has that value }
    Procedure SetCaption( const aNewCaption : TCaption );

    { To make sure we always display the content of the console }
    Procedure CheckConsole;

    Procedure LoadIniFile;

    { "Better" error handling }
    Procedure ExceptionOccurred( Sender : TObject; E : Exception );
    Procedure StopAllTimers;

    Procedure wmStartShell( var Message : TMessage ); message wm_StartShell;
    Procedure wmChildExit( var Message : TMessage ); message wm_ChildExit;

    (* Win9x support *)
    Procedure SaveCaption;
    Procedure RestoreCaption;

    Procedure wmNCPaint( var Message : TMessage ); message wm_NCPaint;
    Procedure wmNCActivate( var Message : TMessage ); message wm_NCActivate;

    {$IFDEF TraceProgress}
    Procedure TraceProgress( const S : String );
    {$ENDIF}

    Procedure SetBackgroundPainter( aPainterType : TBackgroundPosition );

    Procedure wmUseBitmap( var Message : TMessage ); message wm_UseBitmap;

    (* To initialize the border width etc. *)
    Procedure InitMetrics;

    Procedure CreateParams( var rParams : TCreateParams ); override;

    {$IFDEF TextColors}
    Procedure PaintLine( aCanvas : TCanvas; aXOffset, aYOffset : Integer; const aLine : String );
    {$ENDIF}

    {$IFDEF Sizeable}
    Procedure RefreshScrollbars;
    {$ENDIF}

    {$IFDEF AppBar}
    Procedure WMAppBar( var Msg : TMessage ); message WM_APPBAR_CALLBACK;
    Procedure NCMouseMove( var Msg : TMessage ); message WM_NCMOUSEMOVE;
    Procedure GetSetPosition;

    Procedure HideBar;
    Procedure ShowBar;

    Function SetEdge( aEdge : Integer ) : Boolean;
    Procedure ProjectEdge( aEdge : Integer );

    Procedure EnableHotkey;
    Procedure DisableHotkey;
    Procedure wmHotKey( var Msg : TMessage ); message WM_HOTKEY;

    Procedure HandleMouse( aShift : TShiftState; X,Y : Integer );

    Procedure wmNCHITTEST( var Msg : TMessage ); message WM_NCHITTEST;
    {$ENDIF}

    Procedure EnableBackgroundCommands( aEnabled : Boolean );
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;
  OldWndProc : Pointer;

implementation

{$R *.DFM}

Procedure MoveRect( var rRect : TRect; dX, dY : Integer );
Begin
  With rRect do
    Begin
      Left := Left + dX;
      Right := Right + dX;

      Top := Top + dY;
      Bottom := Bottom + dY;
    End;
End;

Procedure SizeRect( var rRect : TRect; dX, dY : Integer );
(* Moves the right lower corner of rRect *)
Begin
  With rRect.BottomRight do
    Begin
      Inc( X, dX );
      Inc( Y, dY );
    End;
End;

Procedure ClipRect( var rClippedRect : TRect; const rClipRect : TRect );
(* Clips rClippedRect to rClipRect *)
Begin
  rClippedRect.Left := Max( rClippedRect.Left, rClipRect.Left );
  rClippedRect.Top := Max( rClippedRect.Top, rClipRect.Top );
  rClippedRect.Right := Min( rClippedRect.Right, rClipRect.Right);
  rClippedRect.Bottom := Max( rClippedRect.Bottom, rClipRect.Bottom );
End;

Procedure StaticTiledBackground( aForm : TForm; aClientArea : TRect; aBitmapOffset : TPoint; aCanvas : TCanvas; aBackground : TBitmap );
(* Tiles a background all over the form (without clipping) *)
Var X,Y : Integer;
Begin
  If (aBackground.Width <> 0) and (aBackground.Height <> 0)
    then
      Begin
        Y := aClientArea.Top;
        While Y < aClientArea.Bottom do
          Begin
            X := aClientArea.Left;
            While X < aClientArea.Right do
              Begin
                aCanvas.Draw( X,Y, aBackground );
                Inc( X, aBackground.Width );
              End;
            Inc( Y, aBackground.Height );
          End;
      End;
End;

Procedure StaticStretchedBackground( aForm : TForm; aClientArea : TRect; aBitmapOffset : TPoint; aCanvas : TCanvas; aBackground : TBitmap );
(* Stretches a background all over the form (without clipping) *)
Begin
  aCanvas.StretchDraw( aClientArea, aBackground );
End;

Procedure RelativeBackground( aForm : TForm; aClientArea : TRect; aBitmapOffset : TPoint; aCanvas : TCanvas; aBackground : TBitmap );
(* Displays a background. The background origin is in the left upper corner of the desktop, the displayed
   portion varies according to the window position.

   1) The left upper corner of "SourceRect" must always be in the range
      (0..BitmapWidth-1, 0..BitmapHeight)

      SourceRect.TopLeft := SourceRect.TopLeft mod WidthHeight

   2) The width of each rectangle is the intersection of SourceRect with (0,0,BitmapWidth,BitmapHeight)

   3) The next upper-left corner is SourceRect.Width units from the previous

*)

Var SourceRect, DestRect : TRect;
    X, Y : Integer;
begin
  With aForm as TForm1 do
    Begin
      DestRect := aClientArea;
      SourceRect := DestRect;
      Case BorderStyle of
        bsSingle : MoveRect( SourceRect, Left+fXBorderWidth+-1, Top+fCaptionHeight+fYBorderWidth-1 );
      {$IFDEF Sizeable}
      bsSizeable : MoveRect( SourceRect, Left+fXBorderWidth+-1, Top+fCaptionHeight+fYBorderWidth-1 );
      {$ENDIF}
          bsNone : MoveRect( SourceRect, Left, Top );
      End;

      Y := -(SourceRect.Top mod aBackground.Height);
      If SourceRect.Top < 0
        then Dec( Y, aBackground.Height );
      While Y < aForm.ClientHeight do
        Begin
          X := -(SourceRect.Left mod aBackground.Width);
          If SourceRect.Left < 0
            then Dec( X, aBackground.Width );
          While X < aForm.ClientWidth do
            Begin
              aCanvas.Draw( X,Y, aBackground );
              Inc( X, aBackground.Width );
            End;
          Inc( Y, aBackground.Height );
        End;
    End;
End;

Procedure TForm1.SetBackground;
Begin
  fBackground.Free;
  fBackground := aNewBackground;
End;

Procedure TForm1.EnableBackgroundCommands;
Begin
  mnuTransparency.Enabled := aEnabled;
  mnuBackground.Enabled := aEnabled;
End;

Procedure TForm1.LoadDesktopBackground;
Var OldCursorTimer : Boolean;
    NewBackground : TBitmap;
Begin
  OldCursorTimer := CursorTimer.Enabled;
  CursorTimer.Enabled := False;

  (* New-style background loading (hopefully also automatically works under Win9x and Win2k) *)
  NewBackground := TBitmap.Create;
  NewBackground.Width := Screen.Width;
  NewBackground.Height := Screen.Height;

  If ActiveDesktopRunning or (fOS in OSWin9x) or not PaintDesktop( NewBackground.Canvas.Handle )
    then
      Begin
        NewBackground.Free;
        NewBackground := GetDesktopBitmap;
      End;

  Background := NewBackground;

  fBackgroundPainterType := bkgndTile;
  SetBackgroundPainter( bkgndRelative );
  CursorTimer.Enabled := OldCursorTimer;
End;

Function ConsoleCTRLHandler( aCtrlType : DWord ) : Bool; stdcall;
Begin
  Case aCtrlType of
CTRL_BREAK_EVENT,
    CTRL_C_EVENT : Result := True;
    else Result := False;
  End;
End;

{$IFDEF AppBar}
Function EdgeFromPoint( aPoint : TPoint; aBarSize : TPoint ) : Integer;
Begin
  Result := ABE_NONE;
  If aPoint.X <= aBarSize.X
    then Result := ABE_LEFT
    else
  If aPoint.X >= GetSystemMetrics( SM_CXSCREEN ) - aBarSize.X
    then Result := ABE_RIGHT
    else
  If aPoint.Y <= aBarSize.Y
    then Result := ABE_TOP
    else
  If aPoint.Y >= GetSystemMetrics( SM_CYSCREEN ) - aBarSize.Y
    then Result := ABE_BOTTOM;
End;
{$ENDIF}

Const Primaries : Array[0..$F] of TColor = (
$000000, $800000,$008000,$808000,$000080,$800080,$008080,$C0C0C0,
$808080, $FF0000,$00FF00,$FFFF00,$0000FF,$FF00FF,$00FFFF,$FFFFFF
);

procedure TForm1.FormCreate(Sender: TObject);
Var SA : TSecurityAttributes;
    ShellWndPos : TWindowPlacement;

    S : String;

    I, J : Integer;

begin
  {$IFNDEF LoadManual}
  NViewLibSetLanguage( 'English' );
  {$ENDIF}
  Application.OnException := ExceptionOccurred;

  Initializing := True;

  {$IFDEF TextColors}
  For J := 0 to $F do
    For I := 0 to $F do
      With TextColors[J*16+I] do
        Begin
          If J = 0
            then BG := -1
            else BG := Primaries[J];
          FG := Primaries[I];
        End;
  {$ENDIF}

  Application.OnActivate := FormActivate;
  Application.OnDeactivate := FormDeactivate;

  fSending := False;
  fWithBorderstyle := bsSingle;

  Lines := TStringList.Create;
  OldLines := TStringList.Create;

  FillChar( SA, SizeOf( SA ), 0 );
  SA.nLength := SizeOf( SA );
  SA.bInheritHandle := True;
  SA.lpSecurityDescriptor := nil;

  {$IFDEF Win9xTest}
  fOS := osWin95;
  {$ELSE}
  fOS := GetOSType;
  {$ENDIF}

  If fOS in OSWin9x
    then
      Begin
        fForwardMessages := ForwardMessageWin9x;

        {$IFDEF DelayMessages}
        DelayedMessages := TList.Create;
        MessageTimer := TTimer.Create( Self );

        MessageTimer.Interval := 1000;
        MessageTimer.Enabled := False;
        MessageTimer.OnTimer := W9xPumpMessages;
        {$ENDIF}
      End
    else fForwardMessages := ForwardMessageNT;

  (* Open a console window *)
  AllocConsole;

  {$IFDEF TraceProgress}
  TraceProgress( 'Creating console' );
  {$ENDIF}
  (* Get a handle to the screen buffer *)
  Console := CreateFile( 'CONOUT$', GENERIC_WRITE or GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE, @SA, OPEN_EXISTING, 0, 0 );
  {If Console = INVALID_HANDLE_VALUE
    then
      Begin
        AllocConsole;
        Console := CreateFile( 'CONOUT$', GENERIC_WRITE or GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE, @SA, OPEN_EXISTING, 0, 0 );
      End;}

  {$IFDEF TraceProgress}
  TraceProgress( 'Searching for console window' );
  {$ENDIF}

  (* Find the console window *)
  S := IntToHex(GetCurrentThreadID,8) + ' eConsole initializing ...'#0;
  SetConsoleTitle( @S[1] );
  ShellWnd := FindWindow( nil, @S[1] );
  While ShellWnd = 0 do
    Begin
      Sleep( 50 ); (* Wait that the console caption gets set *)
      ShellWnd := FindWindow( nil, @S[1] );
    End;

  (* Hide the real console *)
  ShowWindowAsync( ShellWnd, SW_HIDE );

  {$IFDEF TraceProgress}
  TraceProgress( 'Getting console window position' );
  {$ENDIF}

  SetConsoleCtrlHandler( @ConsoleCTRLHandler, True );

  (* Remember the position of the real console *)
  ShellWndPos.Length := SizeOf( ShellWndPos );
  If not GetWindowPlacement( ShellWnd, @ShellWndPos )
    then RaiseLastWin32Error('FormCreate():GetWindowPlacement()');
  (* And - first things first - output the copyright *)

  WriteLn( VersionMessage );

  {$IFDEF LoadManual}
  WriteLn('Using built-in loading for images');
  {$ELSE}
  WriteLn('Using NViewLib.DLL by K. Nishita');
  {$ENDIF}

  If ActiveDesktopRunning
    then WriteLn( 'Active Desktop is running.' );

  If fOS in OSWin9x
    then
      Begin
        WriteLn( 'Windows 9x detected.' );
        BorderIcons := [];
        If fOS = osWin95
          then mnuGlueToDesktop.Enabled := False;

        {$IFDEF TraceProgress}
        TraceProgress( 'Placing console window out of user space ...' );
        {$ENDIF}
        mnuShowconsole.Enabled := False;
        mnuShowconsole.Checked := False;
        MoveWindow( ShellWnd, -16384, -16384, 0,0, True );

        mnuCloseDivider.Visible := False;
        mnuClose.Visible := False;

        mnuPaste.Visible := False;
        mnuPasteDivider.Visible := False;
      End;

  {$IFDEF TraceProgress}
  TraceProgress( 'Placing eConsole window' );
  {$ENDIF}

  (* And place our window at the position of the console window *)
  If (CmdShow = SW_SHOWNORMAL) or (CmdShow = SW_RESTORE)
    then SetWindowPlacement( Handle, @ShellWndPos );

  (* Set a (temporary) title *)
  SetConsoleTitle( 'eConsole' );

  InitMetrics;

  (* Now set up a background image - just in case that everything else like loading etc. fails ... *)
  Background := SafeBackground;
  fBackgroundPainterType := bkgndRelative;
  SetBackgroundPainter( bkgndTile );

  fDockable := False;
  fAutohide := True;
  fDontMinimize := False;

  LoadIniFile;

  {$IFDEF AppBar}
  Hidden := False;

  HideTimer.Interval := HideWaitTime;
  If fAutohide and fDockable
    then HideTimer.Enabled := True;

  With NormalSize do
    Begin
      X := Width;
      Y := Height;
    End;

  EnableHotkey;
  {$ENDIF}

  PostMessage( Handle, wm_StartShell, 0, 0 );
end;

Procedure TForm1.InvalidateLine;
Var R : TRect;
    CellPos : TPoint;
Begin
  CellPos.Y := CellSize.Bottom * aLine;
  With CellPos do
    R := Rect( 0, Y, Min( Length( Lines[aLine]), Length(OldLines[aLine]) )*CellSize.Right, Y+ CellSize.Bottom );
    {R := Rect( 0, Y, CellSize.Right*ConsoleSize.Right, Y+ CellSize.Bottom );}
  InvalidateRect( Handle, @R, False );
End;

{$IFDEF TextColors}
Function CleanLine( const S : String ) : String;
Var I : Integer;
Begin
  SetLength( Result, Length( S ) div 2 );
  For I := 1 to Length( Result ) do
    Result[ I ] := S[2*I-1];
End;

Procedure TForm1.PaintLine;
(* Paints the text respecting the color attributes *)
Var S : String;
    T : String;
    CurrAttr : Integer;
    CurrPos : Integer;
    AttrStart : Integer;
    XOffset : Integer;
Begin
  XOffset := aXOffset;
  If Length( aLine ) > 0
    then
      Begin
        S := CleanLine( aLine );
        CurrPos := 1;
        While CurrPos <= Length( S ) do
          Begin
            AttrStart := CurrPos;
            CurrAttr := Byte( aLine[2*AttrStart]);
            While (CurrPos < Length( aLine )) and (Byte(aLine[2*CurrPos+2]) = CurrAttr) do
              Inc( CurrPos );
            With TextColors[CurrAttr] do
              Begin
                If BG = -1
                  then SetBKMode( aCanvas.Handle, Windows.TRANSPARENT )
                  else
                    Begin
                      SetBKMode( aCanvas.Handle, Windows.OPAQUE );
                      aCanvas.Brush.Color := BG;
                    End;
                If FG = -1                 (* Transparent foreground not yet allowed *)
                  then
                  else aCanvas.Font.Color := FG;
              End;
            SetLength( T, Length( S ));
            T := System.Copy( S,AttrStart,CurrPos-AttrStart+1);
            Inc( CurrPos );
            aCanvas.TextOut(XOffset, aYOffset, T );
            Inc( XOffset, aCanvas.TextWidth( T ));
          End;
      End;
End;
{$ENDIF}

Procedure TForm1.BuildText;
Var P : ^TCharInfo;
    Q : ^Char;
    _Q : Pointer absolute Q;
    I : Integer;
    J : Integer;

    Tmp : TStringList;

    CurrLine : String;

    CursorInfo : TConsoleCursorInfo;
    Info : TConsoleScreenBufferInfo;

    R : TRect;
Begin
  If (Console = 0)
    then MessageBox( 0, 'Uhoh - something weird happened to the console in BuildText()','',idOK);

  Tmp := OldLines;
  OldLines := Lines;
  Lines := Tmp;
  Lines.Clear;

  {$IFDEF TextColors}
  SetLength( CurrLine, aRowLength*2 );
  {$ELSE}
  SetLength( CurrLine, aRowLength );
  {$ENDIF}
  try
    P := aBuffer;

    If (aRowCount <> OldLines.Count)
      then Invalidate;

    For J := 0 to aRowCount -1 do
      Begin
        Q := @CurrLine[1];
        For I := 0 to aRowLength -1 do
          Begin
             If Char( P^.AsciiChar ) <> #0
              then Q^ := Char( P^.AsciiChar )
              else Q^ := ' ';
            Inc( Q );
            Q^ := Char( Lo( P^.Attributes ) or (Hi( P^.Attributes ) shl 4) );
            Inc( Q );
            Inc( P );
          End;
        Lines.Add( CurrLine );
        If (J < OldLines.Count) and (CurrLine <> OldLines[J])
          then InvalidateLine( J );
      End;

    GetConsoleCursorInfo( Console, CursorInfo );
    If CursorInfo.bVisible
      then
        Begin
          GetConsoleScreenBufferInfo( Console, Info );
          With Info.dwCursorPosition do
            If (CursorPos.X <> X) or (CursorPos.Y <> Y)
              then
                Begin
                  R := GetCursorRect;
                  InvalidateRect( Handle, @R, False );
                  If fOS in osWin9x
                    then
                      Begin
                        Cursorpos.X := X;
                        Cursorpos.Y := Y;
                      End
                    else
                      Begin
                        Cursorpos.X := X - Info.srWindow.Left;
                        Cursorpos.Y := Y - Info.srWindow.Top;
                      End;
                End;
        End;
  finally
  end;
End;

Procedure TForm1.SetCaption;
Begin
  If Caption <> aNewCaption
    then
      Begin
        Self.Caption := aNewCaption;
        Application.Title := aNewCaption;
      End;
End;

Procedure TForm1.ReadInfo;
Var Info : TConsoleScreenBufferInfo;
    Buffer : Pointer;
    BufSize : LongInt;

    LeftUpper : TCOORD;

    Region : TSmallRect;
    Target : TSmallRect;
    TargetSize : TCOORD;

    S : String;
Begin
  If (Console = 0)
    then MessageBox( 0, 'Uhoh - ReadInfo()','',idOK );

  RefreshTimer.Enabled := False;

  If not GetConsoleScreenBufferInfo( Console, Info )
    then
      {$IFnDEF FreeBuild}
        Begin
          RaiseLastWin32Error('ReadInfo():GetConsoleScreenBufferInfo()');
        End;
      {$ENDIF};

  FillChar( Target, SizeOf( Target ), 0 );
  If fOS in osWin9x
    then
      Begin
        Region.Left := 0;
        Region.Top := 0;
        Region.Right := Info.dwSize.X-1;
        Region.Bottom := Info.dwSize.Y-1;
      End
    else Region := Info.srWindow;

  TargetSize.X := Region.Right - Region.Left +1;
  TargetSize.Y := Region.Bottom - Region.Top +1;
  Target.Right := Region.Right - Region.Left +1;
  Target.Bottom := Region.Bottom - Region.Top +1;

  If (ConsoleSize.Right <> Target.Right) or (ConsoleSize.Bottom <> Target.Bottom)
    then If not Initializing then
      Begin
        {$IFDEF TraceProgress}
        TraceProgress( 'ConsoleSize changed - resizing console ...' );
        {$ENDIF}
        ResizeConsole;
      End;

  FillChar( LeftUpper, SizeOf( LeftUpper ), 0 );

  BufSize := (Target.Right)* (Target.Bottom)* SizeOf( TCharInfo );
  GetMem( Buffer, BufSize );

  try
    If ReadConsoleOutput( Console, Buffer, TargetSize, LeftUpper, Region )
      then
        Begin
          BuildText( TargetSize.X, TargetSize.Y, Buffer );

          SetLength( S, 255 );
          GetConsoleTitle( @S[1], Length( S ));
          SetLength( S, Pos( #0, S ) -1 );
          SetCaption( S );
        End
      else RaiseLastWin32Error('ReadInfo():ReadConsoleOutput()');
  finally
    FreeMem( Buffer, BufSize );
  end;

  RefreshTimer.Enabled := True;
End;

procedure TForm1.RefreshTimerTimer(Sender: TObject);
begin
  ReadInfo;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  If fSaveConfig
    then ConfigFile.Store( nil, nil );

  {$IFDEF AppBar}
  If fDockable and (AppBarData.uEdge <> ABE_NONE)
    then
      Begin
        SHAppBarMessage (ABM_REMOVE, AppBarData );
        DisableHotkey;
      End;
  {$ENDIF}

  {$IFDEF DragDrop}
  DragAcceptFiles( Handle, False );
  {$ENDIF}

  (* Release our handle to the console *)
  CloseHandle( Console );
  FreeConsole;

  (* And close the console (if cmd.exe is still running for example) *)
  If ShellWnd <> 0
    then SendMessage( ShellWnd, WM_CLOSE, 0, 0 );

  Action := caFree;
end;

{$IFDEF DragDrop}
Procedure TForm1.wmDropFiles;
Begin
  With Message do
    Begin
    {Result := }{PostMessage( ShellWnd, Msg, wParam, lParam );}
      Result := SendMessage( ShellWnd, Msg, wParam, lParam );
      {Result := 0;}
    End;
End;
{$ENDIF}

Procedure TForm1.wmUseBitmap;
Var TmpBitmap : TBitmap;
{    DC : hDC;
    MyCanvas : TCanvas;}
Begin
  If Message.wParam <> 0
    then
      Begin
        Background := TBitmap( Message.wParam );
{
        DC := GetDC( 0 );
        MyCanvas := TCanvas.Create;
        MyCanvas.Handle := DC;
        MyCanvas.Draw( 0,0,Background );
        MyCanvas.Free;
}
        mnuStretchBackground.Enabled := True;
        If fStretchBackground and (fTransparency = 0)
          then
            Begin
              TmpBitmap := TBitmap.Create;
              TmpBitmap.Width := ClientWidth;
              TmpBitmap.Height := ClientHeight;
              TmpBitmap.Canvas.StretchDraw( Rect( 0,0,ClientWidth,ClientHeight), Background );
              Background := TmpBitmap;
            End;

        Invalidate;
        EnableBackgroundCommands( True );
        Message.Result := 1;
      End
    else Message.Result := 0;
End;

Function TForm1.LoadBackgroundImage;
Var Filename : String;
    PictureDialog : TOpenPictureDialog;
Begin
  RefreshTimer.Enabled := False;
  CursorTimer.Enabled := False;

  Result := False;

  If aFilename <> ''
    then Filename := aFilename
    else
      Begin
        Filename := '';
        PictureDialog := TOpenPictureDialog.Create( Self );
        try
          With PictureDialog do
            Begin
              Filter := 'Image files|*.BMP;*.DIB;*.RLE;*.GIF;*.PCX;*.TGA;*.JPG;*.JIF|Windows Bitmaps|*.BMP|Device independant ditmaps|*.DIB|Compuserve GIF|*.GIF|JIF|*.JIF|JPeG|*.JPG|PCX|*.PCX|TARGA Images|*.TGA|Run Length Encoded Bitmaps|*.RLE|';
              {Filter := 'Image files|*.BMP;*.DIB;*.RLE;*.JPG;*.JIF|Windows Bitmaps|*.BMP|Device independant ditmaps|*.DIB|JPeG|*.JPG';}
              Options := [ofFileMustExist];
            End;
            If PictureDialog.Execute
              then
                Begin
                  Filename := PictureDialog.Filename;
                  Result := True;
                End;
        finally
          PictureDialog.Free;
        end;
      End;

  If (Filename <> '')
    then
      Begin
        EnableBackgroundCommands( False );
        CBitmapLoadThread.Create( Self, Filename );
        BackgroundFilename := Filename;
      End;

  RefreshTimer.Enabled := True;
  CursorTimer.Enabled := True;
End;

Procedure TForm1.LoadIniFile;
Var INIFilename : String;
    {$IFnDEF TraceProgress}
    Dummy : Boolean;
    {$ENDIF}
    ForceWin9x : Boolean;
Begin
  INIFilename := DirAdd( HomeDir, 'econsole.ini' );

  {$IFDEF TraceProgress}
  ProcessCommandLine( fTrace, INIFilename, ShellCommandline, ForceWin9x );
  {$ELSE}
  ProcessCommandLine( Dummy, INIFilename, ShellCommandline );
  {$ENDIF}
  If Pos( '\',INIFilename ) = 0
    then INIFilename := '.\' + INIFilename;

  If ForceWin9x
    then fOS := osWin95; 

  {$IFDEF TraceProgress}
  TraceProgress('Initializing from "'+INIFilename+'"' );
  {$ENDIF}

  (* Select a sensible default ... *)
  fDirectBlit := fOS in osWinNT;

  ConfigFile := CINIConfiguration.Create( 'eConsole', INIFilename );
  ConfigFile.Add( CColorPropertyConfigurationItem.Create( 'TintColor', GetTintColor, SetTintColor ));
  ConfigFile.Add( CFontPropertyConfigurationItem.Create( 'Font', GetFont, SetFont ));
  ConfigFile.Add( CStringConfigurationItem.Create( 'BackgroundImage', BackgroundFilename ));
  ConfigFile.Add( CIntegerPropertyConfigurationItem.Create( 'RelativeBackground', GetRelativeBackground, SetRelativeBackground ));
  ConfigFile.Add( CIntegerPropertyConfigurationItem.Create( 'Transparency', GetTransparency, SetTransparency ));
  ConfigFile.Add( CStringConfigurationItem.Create( 'Cursor', CursorName ));
  ConfigFile.Add( CBooleanConfigurationItem.Create( 'NoBorder', fNoBorder ));
  ConfigFile.Add( CBooleanConfigurationItem.Create( 'MouseDrag', fMouseDraggable ));
  ConfigFile.Add( CBooleanConfigurationItem.Create( 'FastDrag', fFastDrag ));
  ConfigFile.Add( CBooleanConfigurationItem.Create( 'AnimateCursor', fAnimateCursor ));
  ConfigFile.Add( CBooleanConfigurationItem.Create( 'DirectBlit', fDirectBlit ));
  ConfigFile.Add( CBooleanConfigurationItem.Create( 'StretchBackground', fStretchBackground ));

  ConfigFile.Add( CIntegerConfigurationItem.Create( 'StartupPositionStyle', fStartupPosition ));
  ConfigFile.Add( CIntegerConfigurationItem.Create( 'StartupPositionX', fStartupX ));
  ConfigFile.Add( CIntegerConfigurationItem.Create( 'StartupPositionY', fStartupY ));

  ConfigFile.Add( CIntegerConfigurationItem.Create( 'HotKeyCode', fHotKeyChar ));

  ConfigFile.Add( CBooleanConfigurationItem.Create( 'DontMinimize', fDontMinimize ));

  {$IFDEF AppBar}
  ConfigFile.Add( CBooleanConfigurationItem.Create( 'Dockable', fDockable ));
  ConfigFile.Add( CBooleanConfigurationItem.Create( 'Autohide', fAutohide ));
  ConfigFile.Add( CIntegerConfigurationItem.Create( 'StartupEdge', AppBarData.uEdge ));
  ConfigFile.Add( CIntegerConfigurationItem.Create( 'StartupEdgeWidth', BarSize.X ));
  ConfigFile.Add( CIntegerConfigurationItem.Create( 'StartupEdgeHeight', BarSize.Y ));
  {$ENDIF}

  {$IFDEF Sizeable}
  ConfigFile.Add( CBooleanConfigurationItem.Create( 'Autosize', fAutosize ));
  {$ENDIF}
  If fOS <> osWin95
    then ConfigFile.Add( CBooleanConfigurationItem.Create( 'GlueToDesktop', fGlueToDesktop ));
  ConfigFile.Add( CIntegerPropertyConfigurationItem.Create( 'Refresh', GetRefresh, SetRefresh ));

  {$IFDEF DelayMessages}
  ConfigFile.Add( CIntegerPropertyConfigurationItem.Create( 'MessagePump', GetMessagePump, SetMessagePump ));
  {$ENDIF}

  ConfigFile.Load( nil, nil );

  End;

Procedure TForm1.wmStartShell;

  Procedure SpawnWindows9xShell( const aShellCommandLine : String );
  Var SA : TSecurityAttributes;
      Startup : TStartupInfo;
      Info : TProcessInformation;

      S : String;
      Comspec : String;
  Begin
    FillChar( SA, SizeOf( SA ), 0 );
    SA.nLength := SizeOf( SA );
    SA.bInheritHandle := True;
    SA.lpSecurityDescriptor := nil;

    FillChar( Startup, SizeOf( Startup ), 0 );
    Startup.cb := SizeOf( Startup );
    S := 'eConsole command window ...';
    Startup.lpTitle := @S[1];

    SetLength( Comspec, 255 );
    GetEnvironmentVariable( 'COMSPEC', @Comspec[1], Length( Comspec ));
    SetLength( Comspec, Pos( #0, Comspec ) -1);
    If Comspec = ''
      then raise Exception.Create('wmStartShell(): The environment variable COMSPEC is not set.');
    Comspec := Comspec + ' ' + aShellCommandline;

    {$IFDEF Conout}
    WriteLn('Starting "'+PChar( @Comspec[1] )+'"...');
    {$ENDIF}

    If not CreateProcess( nil, @Comspec[1], nil,nil,True, 0, nil,nil, Startup, Info )
      then RaiseLastWin32Error('wmStartShell():CreateProcess() for "'+Comspec+'"')
      else CHandleWaitThread.Create( Self, Info.hProcess );
  End;

Begin
  RefreshOptions;

  {$IFDEF TraceProgress}
  TraceProgress('Starting shell...' );
  {$ENDIF}

  If fOS in OSWin9x
    then SpawnWindows9xShell( ShellCommandLine )
    else CAsynchronousChildWaitThread.Create( Self, ShellCommandline );

  {$IFDEF TraceProgress}
  TraceProgress('Shell is starting...' );
  {$ENDIF}

  RefreshTimer.Enabled := True;
  CursorTimer.Enabled := True;
  ConsoleCheckTimer.Enabled := True;

  Message.Result := 0;

  (* We're done, the form is now in a stable state ... *)
  Initializing := False;
  fSaveConfig := True;

  {$IFDEF DragDrop}
  DragAcceptFiles( Handle, True );
  {$ENDIF}
End;

procedure TForm1.FormShow(Sender: TObject);
begin
  {$IFDEF CONOUT}
  WriteLn('Showing form ...');
  {$ENDIF}

  {$IFDEF Sizeable}
  {$IFDEF IE4Scrollbars}
  If not InitializeFlatSB( Handle )
    then RaiseLastWin32Error('FormShow():InitializeFlatSB()');
  If not FlatSB_SetScrollProp( Handle, WSB_PROP_HSTYLE, FSB_ENCARTA_MODE, True )
    then RaiseLastWin32Error('FormShow():SetScrollProp(HORZ)');
  If not FlatSB_SetScrollProp( Handle, WSB_PROP_VSTYLE, FSB_ENCARTA_MODE, True )
    then RaiseLastWin32Error('FormShow():SetScrollProp(VERT)');
  {$ENDIF}
  {$ENDIF}

  RefreshTimer.Enabled := True;
end;

procedure TForm1.WMEraseBackground;
begin
  Message.Result := LRESULT(False);
end;

Procedure TForm1.wmEnterSizeMove( var Message : TMessage );
Begin
  fOldDirectBlit := fDirectBlit;
  fDirectBlit := False;
  If fFastDrag
    then
      Begin
        Message.Result := 0;
        Moving := True;
      End
    else inherited;
End;

Procedure TForm1.wmExitSizeMove( var Message : TMessage );
Begin
  If fFastDrag
    then
      Begin
        Message.Result := 0;
        Moving := False;
        Invalidate;
      End
    else inherited;
  fDirectBlit := fOldDirectBlit;
End;

Procedure TForm1.wmWindowPosChanging;
Begin
  If fGlueToDesktop
    then With TWindowPos( Pointer( Message.lParam )^ ) do
      Begin
        hWndInsertAfter := HWND_BOTTOM;
      End
    else inherited;
End;

procedure TForm1.wmMove;
begin
  {$IFDEF SlowUpdate}
  If fBackgroundPainterType = bkgndRelative
    then
      Begin
        Invalidate;
      End;
  Message.Result := 0;
  {$ENDIF}
end;

Function TForm1.GetCursorRect : TRect;
Var RealCursorPos : TPoint;
    Ch : Char;
    L : String;
Begin
  If (CursorPos.Y < Lines.Count)
    then
      Begin
        L := CleanLine( Lines[CursorPos.Y] );
        RealCursorPos.X := Canvas.TextWidth( Copy( L, 1, CursorPos.X ));
        Ch := L[ CursorPos.X+1 ];
        If Ch = #0 then Ch := ' ';
      End
    else
      Begin
        RealCursorPos.X := CellSize.Right * CursorPos.X;
        Ch := ' ';
      End;
  RealCursorPos.Y := CellSize.Bottom * CursorPos.Y;

  With RealCursorPos do
    Result := Rect( X, Y, X+Canvas.TextWidth( Ch ), Y+CellSize.Bottom );
  With FirstVisible do
    MoveRect( Result, -X, -Y );
End;

procedure TForm1.FormPaint(Sender: TObject);
Var R : TRect;
    I : Integer;
    DrawCanvas : TCanvas;
begin
  If not Assigned( Background )
    then Exit;

  If not Moving
    then
      Begin
        R := ClientRect;


        DrawCanvas := Self.Canvas;
        If (not fDirectBlit) and Assigned( _Screen )
          then DrawCanvas := _Screen.Canvas;

        If Assigned( fBackgroundPainter )
          then fBackgroundPainter( Self, R, FirstVisible, DrawCanvas, Background );

        {$IFnDEF TextColors}
        Windows.SetBKMode( DrawCanvas.Handle, Windows.TRANSPARENT );
        {$ENDIF}

        With FirstVisible do
          For I := 0 to Lines.Count -1 do
            {$IFDEF TextColors}
            PaintLine( DrawCanvas, 0-X,I*(CellSize.Bottom)-Y,Lines[I]);
            {$ELSE}
            DrawCanvas.TextOut( 0-X,I*(CellSize.Bottom)-Y,Lines[I]);
            {$ENDIF}

        If Assigned( Cursor ) and Cursortimer.Enabled
          then Cursor.DrawCursor( DrawCanvas, TextColors[$07].FG, GetCursorRect, fFormIsActive or fAnimateCursor );

        If (not fDirectBlit) and Assigned( _Screen )
          then Canvas.Draw( 0,0, _Screen );
      End;
end;

procedure TForm1.mnuShowconsoleClick(Sender: TObject);
begin
  mnuShowConsole.Checked := not mnuShowConsole.Checked;
  If mnuShowConsole.Checked
    then ShowWindowAsync( ShellWnd, SW_SHOW )
    else ShowWindowAsync( ShellWnd, SW_HIDE );
end;

Procedure TForm1.SetFont;
Begin
  {$IFDEF TraceProgress}
  TraceProgress( 'Setting font ['+TFont(aFont).Name+']' );
  {$ENDIF}

  Font := TFont( aFont );

  (* Select OEM charset for consistency with the console window *)
  Font.Charset := OEM_CHARSET;

  If Assigned( _Screen )
    then _Screen.Canvas.Font := Font;

  {$IFDEF TextColors}
  TextColors[ $07 ].FG := Font.Color;
  {$ENDIF}

  CellSize := Rect( 0,0,Canvas.TextWidth( 'm' ), Canvas.TextHeight( 'Mg|' ));

  If not Initializing
    then
      Begin
        {$IFDEF TraceProgress}
        TraceProgress( 'Font changed - resizing console ...' );
        {$ENDIF}
        ResizeConsole;
      End;
End;

Procedure TForm1.ResizeScreenbuffer;
Begin
  If not fDirectBlit
    then
      Begin
        Application.Title := IntToStr( ClientWidth ) + 'x' + IntToStr( ClientHeight );
        If not Assigned( _Screen )
          then _Screen := TBitmap.Create;
        _Screen.Width := ClientWidth;
        _Screen.Height := ClientHeight;
        _Screen.Canvas.Brush.Style := bsSolid;
        _Screen.Canvas.Font := Font;
      End
    else
      Begin
        _Screen.Free;
        _Screen := nil;
      End;
End;

Procedure TForm1.ResizeConsole;
Var Info : TConsoleScreenBufferInfo;
Begin
  If GetConsoleScreenBufferInfo( Console, Info )
    then
      Begin
        If fOS in osWin9x
          then With Info.srWindow do
            Begin
              Right := Info.dwSize.X-1;
              Bottom := Info.dwSize.Y-1;
            End;

        With Info.srWindow do
          Begin
            ConsoleSize.Right := Right - Left +1;
            ConsoleSize.Bottom := Bottom - Top +1;

            {$IFDEF Sizeable}
            fConsoleSize.X := CellSize.Right * ConsoleSize.Right;
            fConsoleSize.Y := CellSize.Bottom * ConsoleSize.Bottom;
            If fAutoSize and (AppBarData.uEdge = ABE_NONE)
              then
                Begin
            {$ENDIF}
                  ClientWidth := fConsoleSize.X;
                  ClientHeight := fConsoleSize.Y;
            {$IFDEF Sizeable}
                End;
            {$ENDIF}

            If not Initializing
              then ResizeScreenbuffer;
          End;
      End;
End;

procedure TForm1.mnuFontClick(Sender: TObject);
Var Dialog : TFontDialog;
    _Font : TFont;
begin
  Dialog := TFontDialog.Create( Self );
  try
    Dialog.Font := Canvas.Font;
    Dialog.Options := [fdEffects, fdForceFontExist, fdAnsiOnly, fdNoOEMFonts];

    If Dialog.Execute
      then
        Begin
          _Font := Dialog.Font;
          SetFont( _Font );
        End;
  finally
    Dialog.Free;
  end;
end;

Const Pattern100 : TBrushPattern = ($FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF);
Const Pattern75 : TBrushPattern = ($55,$FF,$55,$FF,$55,$FF,$55,$FF);
Const Pattern50Hatch : TBrushPattern = ($55,$AA,$55,$AA,$55,$AA,$55,$AA);
Const Pattern50Scanline : TBrushPattern = ($FF,$00,$FF,$00,$FF,$00,$FF,$00);
Const Pattern25 : TBrushPattern = ($55,$00,$55,$00,$55,$00,$55,$00);

Procedure TForm1.SetBGTransparency;
Var P : TPoint;
    WallpaperFilename : String;
    NewBackground : TBitmap;
    Pattern : PBrushPattern;
Begin
  {$IFDEF TraceProgress}
  TraceProgress( 'Setting transparency ...' );
  {$ENDIF}

  Case aNewTransparency of
    0 : Begin
          If (aReloadBackground and not Initializing)
            then LoadBackgroundImage( BackgroundFilename );
          mnuRelativeBackground.Enabled := True;
        End;
   transTinted,
   25,
   50,
  -50,
   75,
  100 : Begin
          GetDesktopBitmapInfo( WallpaperFilename, fBackgroundTiled, P );
          If (fTransparency <> aNewTransparency) or (fTransparency = transTinted) or Initializing
            then
              Begin
                mnuStretchBackground.Enabled := False;
                {If (aNewTransparency < 0) or (aNewTransparency > fTransparency) or (Background=nil) or (aNewTransparency=transTinted) or Initializing
                  then} LoadDesktopBackground;

                If aNewTransparency = transTinted
                  then
                    Begin
                      Newbackground := FastTint( Background, fTintColor );
                      If Assigned( NewBackground )
                        then Background := Newbackground;
                    End
                  else
                    Begin
                      Case aNewTransparency of
                        25 : Pattern := @Pattern25;
                       -50 : Pattern := @Pattern50Scanline;
                        50 : Pattern := @Pattern50Hatch;
                        75 : Pattern := @Pattern75;
                       100 : Pattern := @Pattern100;
                        else Pattern := @Pattern50Hatch;
                      End;

                      Dim256( Background, Pattern, fTintColor );
                    End;

                SetBackgroundPainter( bkgndRelative );
              End;
          mnuRelativeBackground.Enabled := False;
        End;
  End;

  Case aNewTransparency of
 transTinted : mnuTintimage.Checked := True;
           0 : mnuTransparency0.Checked := True;
          25 : mnuTransparency25.Checked := True;
          50 : mnuTransparency50Hatchpattern.Checked := True;
         -50 : mnuTransparency50Scanlines.Checked := True;
          75 : mnuTransparency75.Checked := True;
         100 : mnuTransparency100.Checked := True;
  End;

  fTransparency := aNewTransparency;
  Invalidate;
End;

procedure TForm1.mnuTransparency0Click(Sender: TObject);
begin
  With Sender as TMenuItem do
    SetBGTransparency( Tag, True );
end;

procedure TForm1.CursorTimerTimer(Sender: TObject);
Var NextStep : LongInt;
    R : TRect;
begin
  If Assigned( Cursor )
    then
      Begin
        If Cursor.AnimateCursor( NextStep )
          then
            Begin
              R := GetCursorRect;
              InvalidateRect( Handle, @R, False );
            End;
        CursorTimer.Interval := NextStep;
      End;
end;

procedure TForm1.mnuSelectCursorClick(Sender: TObject);
Var NewClass : CServiceProviderInformation;
begin
  NewClass := SelectService( Self, serviceCursors );
  If NewClass <> nil
    then
      Begin
        CursorTimer.Enabled := False;
        If Assigned( Cursor ) then Cursor.Free;
        CursorName := NewClass.Visual;
        Cursor := CCursor( NewClass.Instantiate );
        CursorTimer.Interval := 1;
        CursorTimer.Enabled := True;
      End;
end;

procedure TForm1.mnuStretchBackgroundClick(Sender: TObject);
begin
  SetStretchBackground( not fStretchBackground );
end;

Function TForm1.GetFont;
Begin
  GetFont := Font;
End;

Procedure TForm1.SetTransparency;
Begin
  {SetBGTransparency( Integer( aTransparency^ ), True );}
  fTransparency := Integer( aTransparency^ );
End;

Function TForm1.GetTransparency;
Begin
  Result := @fTransparency;
End;

Procedure TForm1.SetTintColor;
Begin
  fTintColor := TColor( aColor^ );
End;

Function TForm1.GetTintColor;
Begin
  Result := @fTintColor;
End;

Procedure TForm1.SetRelativeBackground;
Begin
  fBackgroundPainterType := TBackgroundPosition( aValue^ );
  {SetBackgroundPainter( TBackgroundPosition( aValue^ ));}
End;

Function TForm1.GetRelativeBackground;
Begin
  Result := @fBackgroundPainterType;
End;

Procedure TForm1.SetRefresh;
Begin
  RefreshTimer.Interval := Integer( aValue^ );
  If RefreshTimer.Interval = 0
    then RefreshTimer.Interval := 100;
End;

Function TForm1.GetRefresh;
Begin
  fRefreshMirror := RefreshTimer.Interval;
  Result := @fRefreshMirror;
End;

{$IFDEF DelayMessages}
Procedure TForm1.SetMessagePump;
Begin
  If Assigned( MessageTimer )
    then
      Begin
        MessageTimer.Interval := Integer( aValue^ );
        If MessageTimer.Interval = 0
          then MessageTimer.Interval := 300;
      End;
End;

Function TForm1.GetMessagePump;
Begin
  If Assigned( MessageTimer )
    then fMessageTimerInterval := MessageTimer.Interval
    else fMessageTimerInterval := 300; 
  Result := @fMessageTimerInterval;
End;

{$ENDIF}

procedure TForm1.mnuBackgroundimageClick(Sender: TObject);
begin
  If LoadBackgroundImage( '' )
    then SetBGTransparency( 0, False );
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  If fNoBorder and fMouseDraggable
    then
      Begin
        Dragging := True;

        {$IFDEF AppBar}
        If AppBarData.uEdge <> ABE_NONE
          then
            Begin
              DragX := NormalSize.X div 2;
              DragY := NormalSize.Y div 2;
            End
          else
            Begin
              DragX := X+(Width-ClientWidth);
              DragY := Y+(Height-ClientHeight);
            End;
        {$ELSE}
        DragX := X;
        DragY := Y;
        {$ENDIF}
        SetCapture( Handle );
      End;
end;

Procedure TForm1.HandleMouse( aShift : TShiftState; X,Y : Integer );
{$IFDEF AppBar}
Var P : TPoint;
    Edge : Integer;
{$ENDIF}
Begin
  GetCursorPos( P );

  If (ssCtrl in aShift) or not fDockable
    then Edge := ABE_NONE
    else Edge := EdgeFromPoint( P, BarSize );

  If Edge = ABE_NONE
    then
      Begin
        Left := P.X -DragX;
        Top := P.Y -DragY;
      End;
  ProjectEdge( Edge );

  Invalidate;
End;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  ReleaseCapture;
  Dragging := False;

  {$IFDEF AppBar}
  If fMouseDraggable and (ssLeft in Shift)
    then HandleMouse( Shift, X, Y );
  {$ENDIF}
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  If ssLeft in Shift
    then
      Begin
        {$IFnDEF AppBar}
        If Dragging
          then SetBounds( Left + X - DragX, Top + Y - DragY, Width, Height );
        {$ELSE}
        If Dragging
          then HandleMouse( Shift, X, Y );
        {$ENDIF}
      End
    else
  If Hidden
    then
      Begin
        ShowBar;

        (* Restart timer if we don't have the focus *)
        If fAutohide and (GetForegroundWindow <> Handle)
          then
            Begin
              HideTimer.Enabled := False;
              HideTimer.Enabled := True;
            End;
      End;
end;

procedure TForm1.mnuNoborderClick(Sender: TObject);
begin
  SetBorder( not fNoBorder );
end;

Procedure TForm1.SetBorder;
Begin
  If (fNoBorder <> aBorder) or Initializing
    then
      Begin
        fNoBorder := aBorder;

        If fNoBorder
          then
            Begin
              BorderStyle := bsNone;
              If not Initializing
                then SetBounds( Left + fXBorderWidth, Top + fYBorderWidth + fCaptionHeight, ClientWidth, ClientHeight );
            End
          else
            Begin
              BorderStyle := fWithBorderstyle;
              If not Initializing
                then SetBounds( Left - fXBorderWidth, Top-fYBorderWidth-fCaptionHeight, ClientWidth+fXBorderWidth, ClientHeight+fYBorderWidth );
            End;

        If not Initializing
          then
            Begin
              {$IFDEF TraceProgress}
              TraceProgress( 'Border changed - resizing console ...' );
              {$ENDIF}
              ResizeConsole;
            End;
        mnuNoborder.Checked := fNoBorder;
      End;
End;

Procedure TForm1.SetAnimateCursor;
Begin
  fAnimateCursor := aValue;
  mnuAnimatecursor.Checked := fAnimatecursor;
End;

Procedure TForm1.SetDockable;
Begin
  fDockable := aValue;
  mnuDockable.Checked := aValue;
  mnuAutohide.Enabled := aValue;
End;

Procedure TForm1.SetAutohide;
Begin
  fAutohide:= aValue;
  mnuAutohide.Checked := aValue;
End;

Procedure TForm1.SetDontMinimize;
Begin
  (*
    TODO: Handle (ignoring of) minimize
  *)
  fDontMinimize := aValue;
  mnuDontMinimize.Checked := aValue;

  If aValue
    then BorderIcons := BorderIcons - [ biMinimize ]
    else BorderIcons := BorderIcons + [ biMinimize ];
End;

Procedure TForm1.SetMouseDraggable;
Begin
  fMouseDraggable := aValue;
  mnuMouseDraggable.Checked := fMouseDraggable;
End;

Procedure TForm1.ForwardMessageNT;
Var I : Integer;
Begin
  I := 0;
  While I < aMessages.Count do
    Begin
      With TMsg( aMessages[I]^) do
        PostMessage( ShellWnd, Message, wParam, lParam );
      Inc( I );
    End;
End;

Procedure ClearMessages( aList : TList );
Var I : Integer;
Begin
  With aList do
    For I := 0 to Pred( Count ) do
      FreeMem( Items[I], SizeOf( TMsg ));
End;

{$IFDEF DelayMessages}
Procedure TForm1.W9xPumpMessages;
Var OldShellWndPos : TWindowPlacement;
    I : Integer;

  Procedure SynthetizeMessage( aMessage : Integer; aVKey : Integer; aScancode : Integer );
  Var Flags : Integer;
  Begin
    Flags := 0;
    If (aMessage = wm_KeyDown) or (aMessage = wm_SysKeyDown)
      then aScancode := aScancode or $80
      else Flags := Flags or KEYEVENTF_KEYUP;
    keybd_event( aVKey, aScancode, Flags, 0 );
  End;

Begin
  If DelayedMessages.Count > 0
    then
      Begin
        {$IFDEF CONOUT}
        WriteLn('Forwarding '+IntToStr( Messages.Count )+' messages.');
        {$ENDIF}
        SaveCaption;

        fSending := True;

        FillChar( OldShellWndPos, SizeOf( OldShellWndPos ), 0);
        OldShellWndPos.Length := SizeOf( OldShellWndPos );
        GetWindowPlacement( ShellWnd, @OldShellWndPos );

        SetForegroundWindow( ShellWnd );

        (* Let Windows 9x update and bring the shell window to the foreground -
           this will create annoying flicker in the TaskBar I guess *)
        Sleep( 0 );

        (* And now push the message(s) over *)
        I := 0;
        While I < DelayedMessages.Count do
          Begin
            With TMsg(DelayedMessages.Items[I]^) do
              SynthetizeMessage( Message, wParam, (lParam shr 16) and $FF);
            Inc(I);
          End;
        fSending := False;

        (* If someone ALT-TABbed away, we don't want to keep him ;-) *)
        If GetForegroundWindow = ShellWnd
          then SetForegroundWindow( Handle );
        If not mnuShowConsole.Checked
          then ShowWindow( ShellWnd, SW_HIDE );

        ClearMessages( DelayedMessages );
        DelayedMessages.Count := 0;
        RestoreCaption;
      End;
  MessageTimer.Enabled := False;
End;

Procedure TForm1.ForwardMessageWin9x;
Var I : Integer;
    P : ^TMsg;
Begin
  For I := 0 to aMessages.Count -1 do
    Begin
      Getmem( P, SizeOf( P^ ));
      Move( aMessages[I]^, P^, SizeOf( P^ ));
      {P^ := TMsg( aMessages[I]^ );}
      DelayedMessages.Add( P );
    End;
  MessageTimer.OnTimer( Self );
  {MessageTimer.Enabled := True;}
  (* And wait until the timeout happens ... *)
End;
{$ELSE}
Procedure TForm1.ForwardMessageWin9x;
  Procedure SynthetizeMessage( aMessage : Integer; aVKey : Integer; aScancode : Integer );
  Var Flags : Integer;
  Begin
    Flags := 0;
    If (aMessage = wm_KeyDown) or (aMessage = wm_SysKeyDown)
      then {aScancode := aScancode or $80}
      else Flags := Flags or KEYEVENTF_KEYUP;
    {$IFDEF HookDLL}
    With Journal do
      Begin
        With Messages[MessageCount] do
          Begin
            hWND := ShellWnd;
            Message := aMessage;
            ParamL := aVKey;
            ParamH := aScanCode;
          End;
        Inc( MessageCount );
      End;
    {$ELSE}
    keybd_event( aVKey, aScancode, Flags, 0 );
    {$ENDIF}
  End;

Var {OldForegroundWindow : THandle;}
    OldShellWndPos : TWindowPlacement;
    I : Integer;
Begin
  SaveCaption;

  {$IFDEF HookDLL}
  FillChar( Journal, SizeOf( Journal ), 0 );
  {$ENDIF}

  fSending := True;
  {OldForegroundWindow := GetForegroundWindow;}

  FillChar( OldShellWndPos, SizeOf( OldShellWndPos ), 0);
  OldShellWndPos.Length := SizeOf( OldShellWndPos );
  GetWindowPlacement( ShellWnd, @OldShellWndPos );

  SetForegroundWindow( ShellWnd );

  (* Let Windows 9x update and bring the shell window to the foreground - this will create annoying flicker in the TaskBar I guess *)
  Sleep( 0 );

  (* And now push the message(s) over *)
  I := 0;
  While I < aMessages.Count do
    Begin
      With TMsg(aMessages.Items[I]^) do
        {$IFDEF HookDLL}
        SynthetizeMessage( Message, wParam, lParam );
        {$ELSE}
        SynthetizeMessage( Message, wParam, (lParam shr 16) and $FF);
        {$ENDIF}
      Inc(I);
    End;
  {$IFDEF HookDLL}
  StartHook( @Journal );
  {$ENDIF}
  fSending := False;

  (* If someone ALT-TABbed away, we don't want to keep him ;-) *)
  If GetForegroundWindow = ShellWnd
    then SetForegroundWindow( Handle );
  If not mnuShowConsole.Checked
    then ShowWindow( ShellWnd, SW_HIDE );
  RestoreCaption;
End;
{$ENDIF}

Procedure TForm1.ForwardMessage;
Var Messages : TList;

  Procedure AddMessage( var Message : TMsg );
  Var P : ^TMsg;
  Begin
    GetMem( P, SizeOf( P^ ));
    P^ := Message;
    Messages.Add( P );
  End;

  Procedure AddMsg( var rMessage : TMsg );
  (* Handles the special case of the TAB key *)
  Var TabDownMsg : TMsg;
  Begin
    With rMessage do
      Begin
        (* Handle TAB-up messages and create a TAB-down message *)
        If ((Message = wm_KeyUp) and (wParam = vk_Tab)) or ((Message = wm_SysKeyUp) and (wParam = vk_Tab))
          then
            Begin
              TabDownMsg.Hwnd := ShellWnd;
              If Message = wm_KeyUp
                then TabDownMsg.Message := wm_KeyDown
                else TabDownMsg.Message := wm_SysKeyDown;
              TabDownMsg.wParam := rMessage.wParam and $FFFF;
              TabDownMsg.lParam := rMessage.lParam and $7FFFFFFF;
              AddMessage( TabDownMsg );
            End;

        (* Copy the original message *)
        AddMessage( rMessage );
      End;
  End;

Var Msg : TMsg;
Begin
  {$IFDEF TraceProgress}
  {TraceProgress('Forwarding message(s) ...');}
  {$ENDIF}
  Messages := TList.Create;
  try
    Msg.Hwnd := ShellWnd;
    Msg.Message := Message.Msg {wm_KeyDown};
    Msg.wParam := Message.wParam;
    Msg.lParam := Message.lParam;
    AddMsg( Msg );

    {
    (* Also gobble all other pending keyboard messages *)
    While PeekMessage( Msg, Handle, WM_KEYFIRST, WM_KEYLAST, PM_REMOVE ) do
      AddMsg( Msg );
    }

    (* And stuff the thing into the console *)
    fForwardMessages( Messages );
  finally
    ClearMessages( Messages );
    Messages.Free;

    (* And tell Windows that we handled everything OK *)
    Message.Result := 0;
  end;
End;

Procedure TForm1.SetFastDrag;
Begin
  fFastDrag := aFastDrag;
  mnuFastDrag.Checked := fFastDrag;
End;

procedure TForm1.mnuFastDragClick(Sender: TObject);
begin
  SetFastDrag( not fFastDrag );
end;

Procedure TForm1.SetGlueToDesktop;
Begin
  fGlueToDesktop := aValue;
  mnuGlueToDesktop.Checked := fGlueToDesktop;
  If fGlueToDesktop
    then SetWindowPos( Handle, HWND_BOTTOM, 0,0,0,0, SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE )
    else SetWindowPos( Handle, HWND_TOP, 0,0,0,0, SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE )
End;

{$IFDEF Sizeable}
Procedure TForm1.SetAutosize;
Begin
  fAutosize := aValue;
  mnuAutosize.Checked := fAutosize;
  If fAutosize
    then fWithBorderstyle := bsSingle
    else fWithBorderStyle := bsSizeable;

  If not fNoBorder
    then Borderstyle := fWithBorderstyle;

  If not Initializing
    then
      Begin
        {$IFDEF TraceProgress}
        TraceProgress( 'Autosize changed - resizing console ...' );
        {$ENDIF}
        ResizeConsole;
      End;
End;
{$ENDIF}

Procedure TForm1.SetDirectBlit;
Begin
  fDirectBlit := aValue;
  mnuDirectBlit.Checked := fDirectBlit;
  If not Initializing
    then
      Begin
        {$IFDEF TraceProgress}
        TraceProgress( 'Direct blit changed - resizing console ...' );
        {$ENDIF}

        ResizeScreenbuffer;
      End;
End;

procedure TForm1.mnuGlueToDesktopClick(Sender: TObject);
begin
  SetGlueToDesktop( not fGlueToDesktop );
end;

(* Checks that we are monitoring the currently active screen buffer *)
Procedure TForm1.CheckConsole;
Var CurrConsole : THandle;
Begin
  {$IFDEF Conout}
  WriteLn('Checking console for screen display...');
  {$ENDIF}
  If Console = 0
    then MessageBox( 0, 'Uhoh - CheckConsole()','',idOK );
  CurrConsole := CreateFile( 'CONOUT$', {GENERIC_WRITE or} GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0 );
  If CurrConsole = Console
    then Closehandle( CurrConsole )
    else
      Begin
        CloseHandle( Console );
        Console := CurrConsole;
      End;
End;

procedure TForm1.ConsoleCheckTimerTimer(Sender: TObject);
begin
  CheckConsole;
end;

Procedure TForm1.wmSettingChange;
Var OldTransparency : Integer;
    NewName : String;
    NewTile : Boolean;
    P : TPoint;
Begin
  InitMetrics;
  GetDesktopBitmapInfo( NewName, NewTile, P );
  If (fTransparency <> 0) and ((BackgroundFilename <> NewName) or (fBackgroundTiled <> NewTile))
    then (* Our background image got out of sync with the actual background image *)
      Begin
        OldTransparency := fTransparency;
        fTransparency := 0;
        (* Force a reload of the background *)
        SetBGTransparency( OldTransparency, True );
      End;
End;

Procedure TForm1.StopAllTimers;
Begin
  CursorTimer.Enabled := False;
  ConsoleCheckTimer.Enabled := False;
  RefreshTimer.Enabled := False;
  {$IFDEF Conout}
  WriteLn( 'All timers stopped.' );
  {$ENDIF}
End;

Procedure TForm1.ExceptionOccurred;
Begin
  StopAllTimers;
  Application.OnException := nil;
  fSaveConfig := False;
  MessageBox( 0, PChar(E.Message), 'eConsole', idOK );
End;

Procedure TForm1.wmChildExit;
Begin
  ShellWnd := 0;
  Close;
End;

{ ------------------ }
{   Win 9x support   }
{ ------------------ }

Procedure TForm1.SaveCaption;
Var DC : hDC;
Begin
  If Assigned( OldCaption )
    then OldCaption.Free;
  OldCaption := TBitmap.Create;
  OldCaption.Width := Width;
  OldCaption.Height := GetSystemMetrics( SM_CYCaption );
  DC := GetDCEx( Handle, 0, DCX_WINDOW );
  try
    BitBlt( OldCaption.Canvas.Handle, 0,0,OldCaption.Width,OldCaption.Height, DC, 1,1, srcCopy );
  finally
    ReleaseDC( Handle, DC );
  end;
End;

Procedure TForm1.RestoreCaption;
Var DC : hDC;
Begin
  DC := GetDCEx( Handle, 0, DCX_WINDOW );
  try
    BitBlt( DC, 1,1,OldCaption.Width+1,OldCaption.Height+1, OldCaption.Canvas.Handle, 0,0, srcCopy );
  finally
    ReleaseDC( Handle, DC );
  end;
End;

Procedure TForm1.wmNCPaint;
Begin
  If fSending and Assigned( OldCaption )
    then RestoreCaption
    else inherited;
End;

Procedure TForm1.wmNCActivate;
Begin
  If fSending and Assigned( OldCaption )
    then RestoreCaption
    else inherited;
End;

{$IFDEF TraceProgress}
Procedure TForm1.TraceProgress;
Begin
  If fTrace
    then fTrace := (MessageBox( 0, PChar( S ), 'eConsole', idOK ) <> idCancel);
End;
{$ENDIF}

Procedure TForm1.SetBackgroundPainter;
Begin
  If (aPainterType <> fBackgroundPainterType) or Initializing
    then
      Begin
        If aPainterType = bkgndRelative
          then fBackgroundPainter := RelativeBackground
          else fBackgroundPainter := StaticTiledBackground;
        fBackgroundPainterType := aPainterType;
        mnuRelativeBackground.Checked := (fBackgroundPainterType = bkgndRelative );
        Invalidate;
      End;
End;

procedure TForm1.mnuRelativeBackgroundClick(Sender: TObject);
begin
  If fBackgroundPainterType = bkgndTile
    then SetBackgroundPainter( bkgndRelative )
    else SetBackgroundPainter( bkgndTile );
end;

Procedure TForm1.InitMetrics;
Begin
  (* Metrics section *)
  fXBorderWidth := GetSystemMetrics(SM_CXFrame);
  fYBorderWidth := GetSystemMetrics(SM_CYFrame);
  fCaptionHeight := GetSystemMetrics(SM_CYCaption);
End;

Procedure TForm1.CreateParams;
Begin
  inherited CreateParams( rParams );
  With rParams.WindowClass do
    Begin
      {OldWndProc := lpfnWndProc;
      lpfnWndProc := @MyWndProc;}
    End;
End;

{$IFDEF Sizeable}
procedure TForm1.mnuAutosizeClick(Sender: TObject);
begin
  SetAutoSize( not fAutosize );
end;
{$ENDIF}

procedure TForm1.mnuAnimatecursorClick(Sender: TObject);
begin
  SetAnimateCursor( not fAnimateCursor );
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
  CursorTimer.Enabled := True;
  fFormIsActive := True;

  {$IFDEF AppBar}
  SHAppBarMessage(ABM_ACTIVATE, AppBarData );
  HideTimer.Enabled := False;
  ShowBar;
  {$ENDIF}
end;

procedure TForm1.FormDeactivate(Sender: TObject);
Var R : TRect;
begin
  fFormIsActive := False;

  {CursorTimer.Enabled := False;}
  R := GetCursorRect;
  InvalidateRect( Handle, @R, False );

  {$IFDEF AppBar}
  If fAutohide and (AppBarData.uEdge <> ABE_NONE)
    then HideTimer.Enabled := True;
  {$ENDIF}
end;

Procedure TForm1.WndProc;
Begin
  Case rMessage.Msg of
      WM_KEYUP,
    WM_KEYDOWN,
   WM_SYSKEYUP,
 WM_SYSKEYDOWN : ForwardMessage( rMessage );
 else inherited WndProc( rMessage );
  End;
End;

procedure TForm1.mnuDirectBlitClick(Sender: TObject);
begin
  SetDirectBlit( not fDirectBlit );
end;

{$IFDEF Sizeable}
Procedure TForm1.wmHScroll;
Begin
  With Message do
    Begin
      Case (wParam and $FFFF) of
         SB_THUMBTRACK : FirstVisible.X := wParam shr 16;
             SB_PAGEUP : FirstVisible.X := Max( 0, FirstVisible.X - ClientWidth );
           SB_PAGEDOWN : FirstVisible.X := Min( Max( 0, fConsoleSize.X-ClientWidth ), FirstVisible.X + ClientWidth );
             SB_LINEUP : FirstVisible.X := Max( 0, Pred( FirstVisible.X ));
           SB_LINEDOWN : FirstVisible.X := Min( Max( 0, fConsoleSize.X-ClientWidth ), Succ( FirstVisible.X ));
     SB_THUMBPOSITION  : FirstVisible.X := wParam shr 16;
      End;
      {$IFDEF IE4Scrollbars}
      FlatSB_SetScrollPos( Handle, SB_HORZ, FirstVisible.X, True );
      {$ELSE}
      SetScrollPos( Handle, SB_HORZ, FirstVisible.X, True );
      {$ENDIF}
      Invalidate;
      Result := 0;
    End;
End;

Procedure TForm1.wmVScroll;
Begin
  With Message do
    Begin
      Case (wParam and $FFFF) of
         SB_THUMBTRACK : FirstVisible.Y := wParam shr 16;
             SB_PAGEUP : FirstVisible.Y := Max( 0, FirstVisible.Y - ClientHeight );
           SB_PAGEDOWN : FirstVisible.Y := Min( Max( 0, fConsoleSize.Y-ClientHeight ), FirstVisible.Y + ClientHeight );
             SB_LINEUP : FirstVisible.Y := Max( 0, Pred( FirstVisible.Y ));
           SB_LINEDOWN : FirstVisible.Y := Min( Max( 0, fConsoleSize.Y-ClientHeight ), Succ( FirstVisible.Y ));
     SB_THUMBPOSITION  : FirstVisible.Y := wParam shr 16;
      End;
      {$IFDEF IE4Scrollbars}
      FlatSB_SetScrollPos( Handle, SB_VERT, FirstVisible.Y, True );
      {$ELSE}
      SetScrollPos( Handle, SB_VERT, FirstVisible.Y, True );
      {$ENDIF}
      Invalidate;
      Result := 0;
    End;
End;

Procedure TForm1.RefreshScrollbars;
  Procedure RefreshScrollbar( aScrollbar : Integer; aMax : Integer; aPage : Integer );
  Var ScrollInfo : TScrollInfo;
  Begin
    FillChar( ScrollInfo, SizeOf( ScrollInfo ), 0 );
    With ScrollInfo do
      Begin
        cbSize := SizeOf( ScrollInfo );
        fMask := SIF_PAGE or SIF_RANGE;
        nMin := 0;
        nMax := aMax;
        nPage := aPage;
      End;
    {$IFDEF IE4Scrollbars}
    FlatSB_SetScrollInfo( Handle, aScrollbar, ScrollInfo, True );
    {$ELSE}
    SetScrollInfo( Handle, aScrollbar, ScrollInfo, True );
    {$ENDIF}
  End;

Var Refresh : Boolean;
Begin
  RefreshScrollbar( SB_HORZ, fConsoleSize.X-1, ClientWidth );
  RefreshScrollbar( SB_VERT, fConsoleSize.Y-1, ClientHeight );

  Refresh := False;
  If FirstVisible.X + ClientWidth > fConsoleSize.X
    then
      Begin
        FirstVisible.X := Max( fConsoleSize.X - ClientWidth, 0 );
        Refresh := True;
      End;
  If FirstVisible.Y + ClientHeight > fConsoleSize.Y
    then
      Begin
        FirstVisible.Y := Max( fConsoleSize.Y - ClientHeight, 0 );
        Refresh := True;
      End;
  If Refresh
    then
      Begin
        If not Initializing
          then
            Begin
              {$IFDEF TraceProgress}
              TraceProgress( 'Scrollbar changed - resizing console ...' );
              {$ENDIF}
              ResizeConsole;
            End;
        Invalidate;
      End;
End;

procedure TForm1.FormResize(Sender: TObject);
begin
  {$IFDEF AppBar}
  If not (Dragging or Initializing)
    then
      Begin
        Case AppBarData.uEdge of
          ABE_NONE : Begin
                       NormalSize.X := Width;
                       NormalSize.Y := Height;
                     End;
           ABE_TOP,
        ABE_BOTTOM : BarSize.Y := Height;
         ABE_LEFT,
         ABE_RIGHT : BarSize.X := Width;
        End;
      End;
  {$ENDIF}

  Invalidate;

  ResizeScreenBuffer;
  RefreshScrollbars;
end;
{$ENDIF}

procedure TForm1.mnuCloseClick(Sender: TObject);
begin
  Perform( WM_CLOSE, 0,0 );
end;

procedure TForm1.mnuPasteClick(Sender: TObject);
Var S : String;
    I : Integer;
    Msg : TMessage;
begin
  With Clipboard do
    Begin
      S := AsText;
      I := 1;
      FillChar( Msg, SizeOf( Msg ), 0 );
      While I <= Length( S )do
        Begin
          With Msg do
            Begin
              Msg := WM_CHAR;
              wParam := Ord( S[I] );
            End;
          Inc( I );
          ForwardMessage( Msg );
        End;
    End;
end;

procedure TForm1.PopupMenuPopup(Sender: TObject);
begin
  mnuPaste.Enabled := Clipboard.AsText <> '';
end;

procedure TForm1.mnuSelectTintcolorClick(Sender: TObject);
Var Dialog : TColorDialog;
begin
  Dialog := TColorDialog.Create( Self );
  try
    Dialog.Color := fTintColor;
    Dialog.Options := [cdAnycolor, cdFullopen];

    If Dialog.Execute
      then
        Begin
          fTintColor := Dialog.Color;
          {fTransparency := 0;}
          SetBGTransparency( transTinted, True );
        End;
  finally
    Dialog.Free;
  end;
end;

Procedure TForm1.SetStretchBackground;
Begin
  fStretchBackground := aValue;
  mnuStretchBackground.Checked := fStretchBackground;
  If fTransparency = 0
    then LoadBackgroundImage( BackgroundFilename );
End;

procedure TForm1.mnuMousedraggableClick(Sender: TObject);
begin
  SetMouseDraggable( not fMouseDraggable );
end;

Procedure TForm1.RefreshOptions;
Var CursorInfo : CServiceProviderInformation;
Begin
  If CursorName <> ''
    then
      Begin
        CursorInfo := ServiceManager.ProviderByVisual( serviceCursors, CursorName );
        If Assigned( CursorInfo )
          then Cursor := CCursor( CursorInfo.Instantiate )
          else Cursor := CHLineCursor.Create;
      End
    else Cursor := CHLineCursor.Create;

  If fStartupPosition = positionFixed
    then
      Begin
        Top := fStartupY;
        Left := fStartupX;
      End;

  SetFastDrag( fFastDrag );
  SetAnimateCursor( fAnimateCursor );
  SetStretchBackground( fStretchBackground );
  SetMouseDraggable( fMouseDraggable );
  {$IFDEF Sizeable}
  SetAutosize( fAutosize );
  {$ENDIF}
  SetGlueToDesktop( fGlueToDesktop );

  SetBorder( fNoBorder );          (* Provoke a border refresh on startup *)

  SetAutohide( fAutohide );
  SetDockable( fDockable );
  If fDockable
    then SetEdge( AppBarData.uEdge )
    else SetEdge( ABE_NONE );

  ResizeScreenBuffer;
  ResizeConsole;

  SetBackgroundPainter( fBackgroundPainterType );
  SetDirectBlit( fDirectBlit );
  SetBGTransparency( fTransparency, True );
End;

{$IFDEF AppBar}
Procedure TForm1.DisableHotkey;
Begin
  UnregisterHotkey( Handle, KEY_ID );
End;

Procedure TForm1.EnableHotkey;
Begin
  If fHotKeyChar <> 0
    then
      If not RegisterHotkey( Handle, KEY_ID, MOD_WIN, fHotKeyChar )
        then {Application.MessageBox( 'Cannot register hotkey','', idOK )};
End;

Function EdgeRect( aEdge : Integer; aSize : TPoint ) : TRect;
Begin
  Result := Rect( 0,0, GetSystemMetrics( SM_CXSCREEN ), GetSystemMetrics( SM_CYSCREEN ));
  Case aEdge of
    ABE_LEFT : Result.Right := aSize.X;
   ABE_RIGHT : Result.Left := Result.Right - aSize.X;
     ABE_TOP : Result.Bottom := aSize.Y;
  ABE_BOTTOM : Result.Top := Result.Bottom - aSize.Y;
  End;
End;

Procedure TForm1.WMAppBar;
Var State : Integer;
Begin
  Case Msg.WParam of
    ABN_POSCHANGED : GetSetPosition;
   ABN_STATECHANGE : Begin
                       State := SHAppBarMessage( ABM_GetState, AppBarData );
                       If (State and ABS_ALWAYSONTOP)<> 0
                         then SetWindowPos( Handle, HWND_TOPMOST, 0,0,0,0,SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE )
                         else SetWindowPos( Handle, HWND_BOTTOM, 0,0,0,0,SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE );
                     End;
  End;
End;

Procedure TForm1.GetSetPosition;
Begin
  If SHAppBarMessage( ABM_QUERYPOS, AppBarData ) <> 0
    then
      Begin
        SHAppBarMessage( ABM_SETPOS, AppBarData );
        With AppBarData.rc do
          SetBounds( Left, Top, Right-Left, Bottom-Top );
      End;
End;

Procedure TForm1.ShowBar;
Begin
  With AppBarData do
    Begin
      If Hidden and (uEdge <> ABE_NONE)
        then
          Begin
            rc := EdgeRect( uEdge, BarSize );
            GetSetPosition;
            Hidden := False;
          End;
    End;
End;

Procedure TForm1.HideBar;
Var StartTime : LongInt;
    EndTime : LongInt;
    Time : LongInt;
    Percentage : Real;
    X, Y : Integer;
    L,T : Integer;

Const Interval = 700;
Begin

  X := 0; Y := 0;
  Case AppBarData.uEdge of
       ABE_TOP : Y := -1;
    ABE_BOTTOM : Y := +1;
      ABE_LEFT : X := -1;
     ABE_RIGHT : X := +1;
  End;

  StartTime := GetTickCount;
  EndTime := StartTime + Interval;

  L := Left;
  T := Top;

  Time := GetTickCount;
  While Time < EndTime do
    Begin
      Percentage := ( Time - StartTime ) / Interval;

      SetBounds( L + X*(Round(Width * Percentage)-2), T+Y*(Round( Height * Percentage )-2), Width, Height );

      Application.ProcessMessages;
      Time := GetTickCount;
    End;

  With AppBarData do
    rc := Rect( L+X*(Width-2), T+Y*(Height-2), L+Width+X*(Width-2), T+Height+Y*(Height-2) );

  GetSetPosition;
  Hidden := True;
End;

procedure TForm1.HideTimerTimer(Sender: TObject);
Var P : TPoint;
begin
  GetCursorPos( P );

  If not ptInRect( AppBarData.rc, P )
    then
      Begin
        HideTimer.Enabled := False;
        HideBar;
      End;
end;

Procedure TForm1.NCMouseMove;
Begin
  If AppBarData.uEdge <> ABE_NONE
    then
      Begin
        ShowBar;

        (* Restart timer if we don't have the focus *)
        If fAutohide and (GetForegroundWindow <> Handle)
          then
            Begin
              HideTimer.Enabled := False;
              HideTimer.Enabled := True;
            End;
      End;
End;

Function TForm1.SetEdge;
Var L : LongInt;
    QueryData : TAppBarData;
Begin
  Result := True;

  If (aEdge = AppBarData.uEdge) and not Initializing
    then Exit;

  If (aEdge <> ABE_NONE)
    then
      Begin
        FormStyle := fsStayOnTop;

        With QueryData do
          Begin
            FillChar( AppBarData, SizeOf( AppBarData ), 0 );
            cbSize := SizeOf( AppBarData );
            uEdge := aEdge;
          End;

          L := SHAppBarMessage( ABM_GETAUTOHIDEBAR, QueryData );
          If (L > 0) and (L <> Handle)
            then Result := False
            else
              Begin

                With AppBarData do
                  Begin
                    FillChar( AppBarData, SizeOf( AppBarData ), 0 );
                    cbSize := SizeOf( AppBarData );
                    hWnd := Handle;
                    uCallbackMessage := WM_APPBAR_CALLBACK;

                    uEdge := aEdge;

                    rc := EdgeRect( uEdge, BarSize );
                  End;

                Application.OnDeactivate := OnDeactivate;
                Application.OnActivate := FormActivate;

                L := GetWindowLong( Handle, GWL_EXSTYLE );
                SetWindowLong( Handle, GWL_ExStyle, L or WS_EX_TOOLWINDOW );

                AppBarData.lParam := 1;
                If SHAppBarMessage( ABM_SETAUTOHIDEBAR, AppBarData ) = 0
                  then Caption := ':-((';

                GetSetPosition;
                ShowWindow( Application.Handle, SW_HIDE );
              End;
      End
    else
      Begin
        Formstyle := fsNormal;
        
        ShowWindow( Application.Handle, SW_SHOW );

        With NormalSize do
          SetBounds( Left, Top, X, Y );

        AppBarData.uEdge := aEdge;
      End;

  If not Initializing
    then ResizeConsole;

  (* Reenable hotkey to work around the Delphi class library *)
  (* Because changing the window style means closing the window and opening a new one *)
  DisableHotkey;
  EnableHotkey;
End;

Procedure TForm1.ProjectEdge;
Begin
  SetEdge( aEdge );
End;

Procedure TForm1.wmHotkey;
Begin
  Showbar;
  Application.BringToFront;
End;

Procedure TForm1.wmNCHITTEST;
Begin
  inherited;

  If (AppBarData.uEdge <> ABE_NONE) and (Msg.Result=HTCLIENT)
    then
      Begin
        Case AppBarData.uEdge of
          ABE_LEFT : If Msg.LParamLo >= Width -2 then Msg.Result := HTRIGHT;
           ABE_TOP : If Msg.LParamHi >= Height -2 then Msg.Result := HTBOTTOM;
         ABE_RIGHT : If Msg.LParamLo <= 2 then Msg.Result := HTLEFT;
        ABE_BOTTOM : If Msg.LParamHi <= 2 then Msg.Result := HTTOP;
        End;
      End;
End;

{$ENDIF}

procedure TForm1.mnuDockableClick(Sender: TObject);
begin
  SetDockable( not fDockable );
end;

procedure TForm1.mnuAutohideClick(Sender: TObject);
begin
  SetAutohide( not fAutohide );
end;

procedure TForm1.mnuDontMinimizeClick(Sender: TObject);
begin
  SetDontMinimize( not fDontMinimize );
end;

end.
